home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ASME's Mechanical Engine…ing Toolkit 1997 December
/
ASME's Mechanical Engineering Toolkit 1997 December.iso
/
ai
/
prlg195b.lzh
/
SAMPLES.LZH
/
LISP.PRO
< prev
next >
Wrap
Text File
|
1986-07-20
|
2KB
|
99 lines
/* LISP Splicing operations, by Li Su of Richfield, Minnesota: */
car(X,L) :- nth(X,L,1).
first(X,L) :- nth(X,L,1).
second(X,L) :- nth(X,L,2).
third(X,L) :- nth(X,L,3).
fourth(X,L) :- nth(X,L,4).
fifth(X,L) :- nth(X,L,5).
sixth(X,L) :- nth(X,L,6).
/* put the nth element of the list L to X */
nth(X,L,N) :-
N > 0,
((L = []);
(length(L,Len),Len >= N)),
decvar [carx],
carx set '[]',
not(pcar(L,N)),
X = val(carx),
undec carx,!.
pcar([H|T],N) :-
N > 0,
M is N - 1,
carx set H,
nextcar(T,M).
nextcar(L,N) :- pcar(L,N).
cdr(R,L) :- rest(R,L,1).
last(R,L) :-
length(L,Y),
Z is Y - 1,
rest(R,L,Z).
/* put the rest of the list L starting from the nth element to R */
rest(R,L,N) :-
N > 0,
length(L,Len),
Len >= N,
decvar [cdrx],
not(pcdr(L,N)),
R = val(cdrx),
undec cdrx,!.
pcdr([H|T],N) :-
N > 0,
M is N - 1,
cdrx set T,
nextcdr(T,M).
nextcdr(L,N) :- pcdr(L,N).
mklist(L,X,Y) :- L = [X,Y],!.
append([],L,L).
append([X|L1],L2,[X|L3]) :- append(L1,L2,L3).
/* get a list out from an atom */
/* getl(X,2,4,abcdefg), X will be [b,c,d] */
getl(Result,Col1,Col2,List) :-
Col2 >= Col1,
length(List,Len),
M is Len - Col2,
N is Col1 - 1,
((N = 0,L1 = List);
rest(L1,List,N)),
((M = 0,Result = L1);
cond(reverse(L1,L2),
rest(L3,L2,M),
reverse(L3,Result))),!.
reverse([],[]).
reverse([H|T],L) :-
reverse(T,X),
append(X,[H],L).
/* get a new atom out from an atom (line) */
/* fread(X,2,4,abcedf), X will be bce */
fread(Result,Col1,Col2,Line) :-
name(Line,List),
getl(L,Col1,Col2,List),
name(Result,L),!.